perm filename C3DPLT.SAI[TMP,LCS] blob
sn#131240 filedate 1974-11-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PICPLT"
C00006 ENDMK
C⊗;
BEGIN "PICPLT"
REQUIRE "GEOMES.HRD[GEM,HE]" SOURCE_FILE;
DEFINE SUBR="SIMPLE PROCEDURE";
DEFINE α="COMMENT";
DEFINE ⊂="BEGIN";
DEFINE ⊃="END";
INTEGER BODS,FRIN,CRIN,N;STRING STR;
REAL ARRAY RIX(4400),RIY(4400),PENUD(4400);
SUBR MKRIN;
INTEGER CN,CB,CF,CFR,JF;LABEL FOUND;
BEGIN
FRIN←MKNODE(1);CW$(FRIN)←FRIN;CCW$(FRIN)←FRIN;
CAR8$(FRIN)←FRIN;CDR8$(FRIN)←FRIN;
CB←BODS;WHILE BODS≠(CB←CW(CB)) DO BEGIN
CF←CB;WHILE CB≠(CF←NFACE(CF)) DO BEGIN
JF←JY(CF);CFR←FRIN;
WHILE FRIN≠(CFR←CW(CFR)) DO BEGIN
IF JY(CFR)=JF THEN BEGIN
CAR8$(CF)←CAR8(CFR);CAR8$(CFR)←CF;
CDR8$(CF)←CFR;CDR8$(CAR8(CF))←CF;
GO TO FOUND;END;
END;
CN←MKNODE(1);CAR8$(CN)←CF;CDR8$(CN)←CF;
CAR8$(CF)←CN;CDR8$(CF)←CN;
CW$(CN)←CW(FRIN);CW$(FRIN)←CN;JY(CN)←JF;
CCW$(CN)←FRIN;CCW$(CW(CN))←CN;
FOUND:
END;
END;
END;
SUBR MKARRS;
INTEGER CF,CE,CV;
BEGIN
CF←CRIN;WHILE CRIN≠(CF←CAR8(CB)) DO BEGIN
CE←CF;WHILE CF≠(CE←ECW(CE,CF)) DO BEGIN
CV←VCW(CE,CF);RIX(N)←XPP(CV);RIY(N)←YPP(CV);
RIP(N)=PENUD(K);N←N+2;
END;
END;
END;
SIMPLE PROCEDURE DPYRIN(INTEGER RIN);
BEGIN
IF CRIN=FRIN THEN RETURN;
MKARRS;FOR I=1 STEP 3 UNTIL N+2 DO
IF
END;
SUBR PLOTCOL(INTEGER RIN);
BEGIN
OUTSTR([???]);
STR←INSTRL;α???
END;
SUBR TEXTURE;
BEGIN
STR←INSTRL;α?? DOTS OR EVENLY SPACED DOTS,LINES,ZIG ZAGS
KY(CF)←TEX; α WITH OR WITHOUT EDGES
END;
SUBR FILTXT(INTEGER RIN)
BEGIN
SIMPLE FORTRAN PROCEDURE FILL(INTEGER DP,NS,TX);
BEGIN
DIMENSION Q(1),R(1),NE(1)
KK=NE(1)
KJ=2
DO 4 K=2,KK
IF(NE(K).NE.3)GO TO 11
NE(K)=-1
KJ=K+1
GO TO 4
11 NE(K)=0
4 CONTINUE
RLFT=1000
RT=-1000
B=RT
DO 12 K=1,KK
H=IFIX(Q(K))
IF(H.LT.RLFT)RLFT=H
IF(H.GT.RT)RT=H
IF(H.EQ.B)NE(K)=-1
B=H
Q(K)=H
12 R(K)=IFIX(R(K))
NE(KK+1)=-1
LRT=RT
JA=3
124 LEFT=RLFT
51 J=LEFT
42 RJ=J+.001
JCONT=0
LEFT=J
JJ=-1
ALT=-1000.
200 DO 45 L=2,KK
IF(NE(L).NE.0)GO TO 45
IF(MISS(L,RJ,Q))GO TO 45
H=HGHT(L,RJ,Q,R)
IF(H.LT.ALT)GO TO 45
ALT=H
JJ=L
45 CONTINUE
IF(JJ)GO TO 43
JCONT=-1
LEFT=J
46 JA=3
JORD=-1
52 KN=Q(JJ)
KL=Q(JJ-1)
IF(KN.LT.KL)KN=KL
50 I=J
102 RJ=I+.01
ALT=HGHT(JJ,RJ,Q,R)
END;
SUBR COMMANDS;
BEGIN
INTEGER CX;
MKUNIV;GEODPY;
WHILE TRUE DO BEGIN
GEOMED;CX←INCHRW;
IF CX="G" THEN GEOMED;
IF CX="." THEN BEGIN
CRIN←CW(CRIN);DPYRIN(CRIN);END;
IF CX="T" THEN TEXTURE;
IF CX="F" THEN FILTXT(CRIN);
IF CX="P" THEN PLOTCOL(CRIN)
END;
END;
COMMANDS;
END "PICPLT";